home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
pascal
/
zindent7.zip
/
ZINKEYTP.INC
< prev
next >
Wrap
Text File
|
1987-03-30
|
7KB
|
260 lines
(****************************************************************)
(* Include File *)
(* KeyWord Turbo Pascal v. 0600pm, wed, 25.Mar.87, Glen Ellis *)
(****************************************************************)
(* called by :
(* pKEYTP( SOLL, SIP, SIN, SLM, SMW, SEB,SLB
(*
(* parameters sent:
(*
(* (SysOutLine, SysIndentPos, SysIndentNum , SysLenMax, SysMarkWrite );
(* SOLL SIP SIN SLM SMW
(*
(* System Enable Begin flag
(* SEB
(*
(* Begin/End counter :
(* SLB
(*
(* procedure pINDENT() is located in ZinSTR.inc
(*
(* *)
(*---------------------------------------------------------------------------*)
procedure pKEYTP( var KLine : THEstr ; var KIPos : nbr ; KINum , KLenMax : nbr;
var KMwrite, KEB : lgc ; var KLB : nbr);
(* also, uses SysComment
(*
(* requires STRING.INC library of string functions
(* all are var in order to allow sending back altered values
(* kLINE := OutLine
(* kIPOS := indentpos = current indent position
(* kINUM := indentnum = length of indent group
(* KMwrite := KMwrite = controls write to disk
(* *)
var
(* local memvars *)
trimcnt : nbr;
leftmgn : nbr;
wkLINE : THEstr;
KMark : lgc;
x,y,z : nbr;
PosHead : lgc;
PosBegin, PosCase, PosRepeat, PosRecord : nbr;
PosEnd : nbr;
(*========================================================*)
begin (* Proc *)
trimcnt := 0;
leftmgn := 0;
(*--- Trim Right Spaces, We Will Not Pad-Right. *)
(*--- Trim Left Spaces, Count Them, Prep for Margin adjusted Pad-Left *)
pTrimLCntR(kLINE,trimcnt);(**)
(* trimcnt used by KEB controller *)
(*--- Vertical Blank Filler *)
IF (SysVertiate)
and (length(kLine) = 0)
and (KEB)
then kLine := '(**)';
(*
(* this filler group looks cluttered,
(* and was selected as a compromise,
(* because Pascal does not tolerate the semi-colon
(* as a vertical filler between functions and procedures !
(* *)
(*--- Create Working Line *)
wkLINE := kLINE;
(*--- Init *)
KMark := false;
KMwrite := true;
(*--- convert working line to all caps *)
(* pAllCaps(wkLINE); (**)
pUpCaseFirst(wKLine); (**)
(*--- check for pos() of pKEYWORDs *)
(* optional function.
(*---------------------------------------------------
(* detect first occurence of 'begin', then set flag
(* this delaying tactic protects the title/header area.
(**)
IF not KEB (* not started YET ! *)
then
begin
IF (pos('BEGIN',wkLINE)=1) (* time to Start , NOW ! *)
then
begin
TrimCnt := 0;
KEB := true; (* start normal indent now ! *)
(* will not pass through here again ! *)
end;
(* hold on to the current trim left margin counter *)
KIPOS := trimcnt;
end;
(*-------------- Key Enable Begin --------------------*)
IF KEB then (* then enable line parse routines *)
begin
(*---------*)
(* Comment *)
IF ( pos('{',wkLINE) = 1 )
or ( pos('(*',wkLINE) = 1 )
or ( pos(';',wkLINE) = 1 )
or (length(wkLINE)=0)
then
begin
IF SysComment
then pINDENT(kLINE,kIPOS,kLenMax)
ELSE KMwrite := false;
KMark := true;
end;
(*-------< Allow following module to detect keywords >-------*)
(* I forgot to parse for 'RECORD' right through version #5 ! *)
(* Thanks to David Beard, Memphis, Tn, a REAL Programmer ! *)
(*------------------------------------------------*)
(* handle BEGIN / CASE / REPEAT / RECORD head. *)
PosBegin := pos('BEGIN', wkLINE);
PosCase := pos('CASE', wkLINE);
PosRepeat := pos('REPEAT', wkLINE);
PosRecord := pos('RECORD', wkLINE);
PosHead := false;
IF
(
(posBEGIN=1)
and
( (pos('BEGIN ',wkLINE)=1) or (length(wkLINE) = PosBEGIN + 4) )
)
then PosHead := true;
IF
(
(posCASE=1)
and
( (pos('CASE ',wkLINE)=1) or (length(wkLINE) = PosCASE + 3) )
)
then PosHead := true;
IF
(
(posREPEAT=1)
and
( (pos('REPEAT ',wkLINE)=1) or (length(wkLINE) = PosREPEAT + 5) )
)
then PosHead := true;
IF
(
(posRECORD=1)
and
( (pos('RECORD ',wkLINE)=1) or (length(wkLINE) = PosRECORD + 5) )
)
then PosHead := true;
IF PosHead then
begin
pINDENT(kLINE,kIPOS,kLenMax);
kIPOS := kIPOS + kINUM;
KLB := KLB + 1; (* Begin/End counter *)
KMark := true;
KEB := true;
end;
(*------------------*)
(* handle 'IF' tail.*)
IF (pos('THEN ',wkLINE)=1)
or (pos('DO ' ,wkLine)=1)
or (pos('AND ',wkLine)=1)
or (pos('OR ' ,wkLine)=1)
then (* temporary Offset *)
begin
kIPOS := kIPOS + kINUM;
pINDENT(kLINE,kIPOS,kLenMax);
kIPOS := kIPOS - kINUM;
KMark := true;
end;
(*-------------------------------------*)
(* handle 'BEGIN' 'CASE' 'RECORD' tail.*)
PosEnd := pos('END',wkLINE);
IF ( PosEnd = 1 )
and
(
(pos('END ;',wkLINE) = 1)
or
(pos('END;',wkLINE) = 1)
or
(length(wkLINE) = PosEnd + 2)
)
then
begin
(* KEY line *)
kIPOS := kIPOS - kINUM; (* Position *)
pINDENT(kLINE,kIPOS,kLenMax);
KLB := KLB -1; (* Begin/End counter *)
KMark := true;
end;
(*----------------------------------------------*)
(* handle 'REPEAT' tail *)
IF (pos('UNTIL ',wkLINE)=1)
then
begin
(* KEY line *)
kIPOS := kIPOS - kINUM; (* Position *)
pINDENT(kLINE,kIPOS,kLenMax);
KLB := KLB -1; (* Begin/End counter *)
KMark := true;
end;
end; (* KEB *)
(* bottom of IF 'Key Enable Begin' KEB *)
(*-----------------*)
(* NONE of ABOVE *)
IF not(KMark) then
begin
IF (pos('(*>*)',wkLine)=1) (* margin move right *)
then kIPOS := kIPOS + kINUM;
(* normal common line *)
(* left pad current kIPOS count *)
pINDENT(kLINE,kIPOS,kLenMax);
end;
end; (* Proc *)
(********************************************************************)
(*<<<>>>*)